00010	BEGIN "TIPDAT" COMMENT 23-JAN-72;
00020	COMMENT Reads disk file "PHON" containing words and phonetic 
00030	  transcriptions.  Creates a disk file containing counts of the number
00040	  of times each triphone is used in the reviewed list.
00050	;
00060	
00070	REQUIRE "MACROS[SYS,JKS]" SOURCE_FILE;
00080	REQUIRE "COMSUB.HDR[SYS,JKS]" SOURCE_FILE;
00090	
00100	INTEGER IIII,JJJJ,KKKK,LL,QQ,XXXX,YYYY;
00110	INTEGER ARRAY AAAA,BBBB[0:4000];
00130	PRELOAD_WITH '435000000000,'645000000000,'445000000000,'635000000000,
00140	'725000000000,
00150	  '414500000000,'454500000000,'564700000000,'575700000000,'416700000000 ,
00160	   '414100000000,'416200000000;
00170	INTEGER ARRAY PHCOMP[0:11];
00180	INTEGER BRK,BRK1,EOF,I,L,COUNT,COUND,CHOICE,WORDNO;
00190	STRING TSTR,DPH1,DPH2,PH1,PH2,PH3,LIN,WORD,LIN1;
00200	STRING LIST;
00210	
00220	SETBR;
00230	OPEN(DSK,"DSK",1,2,0,120,BRK,EOF);
00240	OPEN(DSKO,"DSK",1,0,2,120,BRK,EOF);
00250	OPEN(TTY,"TTY",1,1,1,120,BRK,EOF);
00260	
00280	ENTEROUT(DSKO,TSTR←"TIPTST.LST");
02560	LOOKIN(DSK,TSTR←"PHON");
02570	EOF ← FALSE; KKKK←COUNT←COUND ← WORDNO ← 0;
02580	
02590	WHILE ¬EOF DO
02600	BEGIN "REREAD"
02610	LIN ← INPUT(DSK,1);
02620	TSTR ← SCAN(LIN,6,BRK);
02630	IF TSTR≠NULL THEN BEGIN WORD ← TSTR; WORDNO ← WORDNO + 1 END;
02640	LIN1←WORD&TB&LIN;
02650	IF LIN[1 FOR 1]=TB THEN LIN←LIN[2 TO ∞];
02660	TSTR←SCAN(LIN,6,BRK);
02670	TSTR←SCAN(LIN,6,BRK); 
02680	TSTR←SCAN(LIN,6,BRK);
02690	LIN←LIN&CR;
02700	BRK ← 0; PH1←SCAN(LIN,10,BRK);
02710	PH3←" ";
02730	IF BRK=CR THEN PH3←"XX";
02740	IF BRK=TB THEN BEGIN PH1←SCAN(LIN,10,BRK); IF BRK=CR THEN PH3←"XX"; END;
02750	IF PH3≠"XX" THEN BEGIN
02760	PH2←SCAN(LIN,10,BRK);
02790	FOR JJJJ←0 STEP 1 UNTIL 11 DO
02800	  IF CVSIX(PH1)=PHCOMP[JJJJ] THEN DONE;
02810	IF JJJJ≥12 THEN PH1←PH1&" ";
02820	FOR JJJJ←0 STEP 1 UNTIL 11 DO
02830	  IF CVSIX(PH2)=PHCOMP[JJJJ] THEN DONE;
02840	IF JJJJ≥12 THEN PH2←PH2&" ";
02850	END;
02860	WHILE (LENGTH(LIN)>0) AND ¬EQU(PH3,"XX") DO
02870	 BEGIN
02880	  IF BRK≠CR THEN BEGIN
02890	  IF BRK=TB THEN
02900	   BEGIN
02910	    PH1←SCAN(LIN,10,BRK);
02930	    IF BRK=CR THEN DONE;
02940	    PH2←SCAN(LIN,10,BRK);
02950	    IF BRK=CR THEN DONE;
02960	    FOR JJJJ←0 STEP 1 UNTIL 11 DO
02970	     IF CVSIX(PH1)=PHCOMP[JJJJ] THEN DONE;
02980	    IF JJJJ≥12 THEN PH1←PH1&" ";
02990	    FOR JJJJ←0 STEP 1 UNTIL 11 DO
03000	     IF CVSIX(PH2)=PHCOMP[JJJJ] THEN DONE;
03010	    IF JJJJ≥12 THEN PH2←PH2&" ";
03020	   END;
03030	  PH3 ← SCAN(LIN,10,BRK);
03040	  FOR JJJJ←0 STEP 1 UNTIL 11 DO
03050	   IF CVSIX(PH3)=PHCOMP[JJJJ] THEN DONE;
03060	  IF JJJJ≥12 THEN PH3←PH3&" ";
03070	  END ELSE PH3←"XX";
03080	  XXXX←CVSIX(PH1&PH2&PH3);
03100	  FOR I←0 STEP 1 UNTIL 3999 DO
03110	   BEGIN
03120	    IF BBBB[I]=0 THEN BEGIN BBBB[I]←XXXX; AAAA[I]←1; COUNT←COUNT+1;  DONE END;
03130	    IF BBBB[I]=XXXX THEN BEGIN AAAA[I]←AAAA[I]+1; COUND←COUND+1; DONE END;
03132	    IF BBBB[I]>XXXX THEN
03134	     BEGIN
03136	      FOR JJJJ←COUNT-1 STEP -1 UNTIL I DO
03138	       BEGIN
03140	        AAAA[JJJJ+1]←AAAA[JJJJ];
03142	        BBBB[JJJJ+1]←BBBB[JJJJ];
03144	       END;
03146	      AAAA[I]←1;
03148	      BBBB[I]←XXXX;
03150	      COUNT←COUNT+1;
03151	      DONE;
03152	     END;
03156	   END;
03158	
03160	  PH1←PH2; PH2←PH3;
03170	 END;
03180	END "REREAD";
03190	CLOSE(DSK);
03200	
03210	OUT(DSKO,CR&FF&"The "&CVS(COUNT)&" different triphones found in addition to "
03220	  &CVS(COUND)&" duplicates"&CRLF&LF);
03230	
03240	KKKK←COUNT-1;
03250	COUNT←0;
03252	FOR I←0 STEP 1 UNTIL KKKK DO
03254	 BEGIN
03256	  OUT(DSKO,CVXSTR(BBBB[I])&TB);
03258	  COUNT←COUNT+1;
03260	  IF COUNT≥14 THEN
03262	   BEGIN
03264	    OUT(DSKO,CRLF);
03266	    COUNT←0;
03268	   END;
03270	 END;
03280	OUT(DSKO,CR&FF&"Usage counts in 10% groups for the "&CVS(KKKK+1)&" triphones in "
03290	  &cvs(wordno)&" words used by 2 or more speakers in Jones and Wexman"&CRLF&LF);
03295	
03300	FOR JJJJ←KKKK-1 STEP -1 UNTIL 0 DO
03310	 FOR I←JJJJ STEP 1 UNTIL KKKK-1 DO
03320	  IF AAAA[I]<AAAA[I+1] THEN BEGIN
03330	   XXXX←AAAA[I]; AAAA[I]←AAAA[I+1]; AAAA[I+1]←XXXX;
03340	   XXXX←BBBB[I]; BBBB[I]←BBBB[I+1]; BBBB[I+1]←XXXX; END
03350	  ELSE DONE;
03360	I←0; COUNT←2; SETFORMAT(5,0); LL←AAAA[I]; QQ←1;
03370	KKKK←(KKKK+1+COUND)%10+1;
03380	OUT(DSKO,CVS(AAAA[I])&TB&CVXSTR(BBBB[I])&TB);
03390	FOR I←1 STEP 1 UNTIL 3999 DO
03400	 BEGIN
03410	  IF AAAA[I]=0 THEN DONE;
03420	  IF AAAA[I]≠AAAA[I-1] THEN 
03430	   BEGIN
03440	    IF COUNT MOD 2 =1 THEN
03450	     BEGIN
03460	      OUT(DSKO,TB); COUNT←COUNT+1;
03470	     END;
03480	    IF COUNT≥3 THEN BEGIN
03490	     FOR L←1 STEP 1 UNTIL 14 DO
03500	      IF AAAA[I]≠AAAA[I+L] THEN DONE;
03510	     IF COUNT+ L≥14 THEN
03520	     BEGIN
03530	      OUT(DSKO,CRLF);
03540	      COUNT←0; JJJJ←AAAA[I];
03550	     END;
03560	    END;
03570	    IF COUNT≥13 THEN
03580	     BEGIN
03590	      OUT(DSKO,CRLF);
03600	      COUNT←0; JJJJ←AAAA[I];
03610	     END;
03620	    OUT(DSKO,CVS(AAAA[I])&TB);
03630	    COUNT←COUNT+1;
03640	   END
03650	  ELSE
03660	   BEGIN
03670	    IF COUNT≥14 THEN
03680	     BEGIN
03690	      OUT(DSKO,CRLF);
03700	      IF AAAA[I]≠JJJJ THEN 
03710	       BEGIN
03720	        JJJJ←AAAA[I];
03730	        OUT(DSKO,CVS(AAAA[I]));
03740	       END;
03750	      OUT(DSKO,TB);
03760	      COUNT←1;
03770	     END;
03780	   END;
03790	  OUT(DSKO,CVXSTR(BBBB[I])&TB);
03800	  COUNT←COUNT+1;
03810	  LL←LL+AAAA[I]; QQ←QQ+1;
03820	  IF LL≥KKKK THEN BEGIN
03830	    LL←LL-KKKK; OUT(DSKO,CRLF&"****"&TB&CVS(QQ)&" Triphones"); COUNT←14; END;
03840	 END;
03850	CLOSE(DSKO);
03860	OUT(TTY,CRLF&"OUTPUT FILE: TIPTST.LST");
03870	
03880	END "TIPDAT";